COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR  7/74
C00023 ENDMK
C⊗;
C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR  7/74

	FUNCTION RMOVX(W,Y,Z)
	IF(W.EQ.0)W=.01
	IF(Y.EQ.0)Y=.01
	RMOVX=Y*((W/Y)**Z)
	END

      SUBROUTINE BGSORT(BW)
C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
C  ALLOWS 100 BG TIMES.
      COMMON /Q/ BNW(100),NWZ
      DO 5308 K=1,NWZ
      X=BNW(K)-.0001
      Y=X+.0002
C   ROUND-OFF NONSENSE
      IF(BW.LE.X)GO TO 5308
       IF(BW.LT.Y)RETURN
5308      CONTINUE
      NWZ=NWZ+1
      BNW(NWZ)=BW
      RETURN
      END

      SUBROUTINE SQYY(YY,X,Y,Z)
      YY=2.*Z/(X+Y)
      IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
      RETURN
      END


      SUBROUTINE QUAD
C  DUMMY -- FOR NOW.  7/74
      END

      SUBROUTINE ACCEL
      COMMON/VV/LIMIT,V(1)/A/ROFF(27),NP(27),PCH(27,32),
     1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
     1 ,P1(27),JFM(4),COPY(30),IFM(80)
     1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
      COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
     1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
     1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
      COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
     1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
     1 ZZ,CHN,YY 
     1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
     1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
     1 LP,ILIT,NLIT,KTMP,IC,NONO,RD,IA
C  /C/=26
      IF(T5.EQ.1)GO TO 4020
      XA=RA
7020  RA=V(IA+K)
      IF(RA.EQ.-10000.)RETURN
4020  RD=1  
      IF(RA.LT.0)RD=-1. 
      RA=RA*RD    
      IF(KA.EQ.0)RA=RA-RC     
      W=RA  
      RB=W  
      IF(W.LE.Z-.0001)GO TO 2020    
C .0001 FOR ROUND-OFF ERRORS!!!!!!!
      IF(Z.NE.0)GO TO 3020    
      RA=RA/Y     
      RB=-1.
      RC=0  
      GO TO 8020  
3020      W=Z     
      RC=W+RC     
      GO TO 24    
2020      RC=0    
24      IF(X.NE.Y)GO TO 424
      RA=W/X
      GO TO 8020
C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
C   BG TIME OF NOTE. CHN=TBG.
424      RAX=XT(J)
      RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
      XT(J)=RAX+YY*RA
8020      IF(KA.EQ.0)RA=RA+XA 
      KA=1  
      IF(T5.NE.1)GO TO 1012
      IF(RC.NE.0)GO TO 2011
      RETURN
C  T5=1 IN 'RUNIT'
1012  V(IA+K)=RA*RD     
      IF(K.EQ.IZ)RETURN     
1011      IF(T5.EQ.1)GO TO 2011     
      K=K+1 
      IF(ZZ.NE.0)Z=Z-W  
      IF(Z.GT.0)GO TO 7020
      IF(RB.EQ.-1.)GO TO 7020     
      IC=IC+1     
      IF(RB.EQ.W)RETURN
      KA=0  
      K=K-1 
      RETURN
2011      XA=RA   
      IF(K.GT.1)GO TO 9020
      K=I-6
      ZPAR=-9900.-CHN-ZZ
      DO 3011 KL=8,I     
      IF(V(K).NE.ZPAR)GO TO 3011
      IF(V(K+1).EQ.990000.)GO TO 9020    
3011      K=K-1
9020      W=ZZ  
      IF(V(K+3))K=K+3
C   ABOVE IS FOR TYPED IN TEMPO CHANGES
      KA=K+3
      ZZ=V(KA)
C   DUR OF NEXT TEMPI
      X=V(KA+1)
      Y=V(KA+2)
213      KA=0  
      Z=ZZ  
      CALL SQYY(YY,X,Y,Z)
      CHN=CHN+W   
      XT(J)=X
      IF(KA.EQ.1)Z=0    
      RA=PR 
      KA=0
      K=K+3
      GO TO 4020
      END

      SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
      COMMON/VV/LIMIT, V(2000)
C  TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
C KODES:  -22=RHY  -33=NOTES  -44=NUMS  -46=RLIST  -36=RNOTES
C   -11=SUBN  -12=SUBR  -55=MOVE NUMS  -56=MOVE NOTES
C  -66=DUPL   -88=LIT  -57=MOVE RANGE NUMS  -58=MOVE RNG NOTES
      DO 1 K=1,2000
      N=V(K)
      IF(N.LT.10000)GO TO 1
      IF(N/10000.NE.INUM)GO TO 1
      IF(MOD(N,10000).NE.IPAR)GO TO 1
      ISTRT=K+4
      KODE=V(K+2)
      ICNT=V(K+3)
      IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
      RETURN
C  FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
1      CONTINUE
      END